home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / pas_0493.zip / MUSIC.PAS < prev    next >
Pascal/Delphi Source File  |  1993-04-23  |  5KB  |  147 lines
  1. ─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
  2. Msg  : 588 of 702                                                               
  3. From : Bill Buchanan                       1:2410/225.0         19 Apr 93  11:48 
  4. To   : Robert Macdonald                                                          
  5. Subj : Music                                                                  
  6. ────────────────────────────────────────────────────────────────────────────────
  7.  -=> Quoting Robert Macdonald to All <=-
  8.  
  9.  RM> I'm just learning Pascal, and I was 1dering if it's possible 2 play
  10.  RM> music in Pascal?  If so... how? 
  11.  RM> C U L8r!
  12.  
  13.  Here's a little program that allows you to play the "PIANO" on your keyboard.
  14.  No soundcard needed or anything like that.  This may give you a small idea
  15.  on how to create your own sounds ...
  16.  
  17.  
  18.  Program Music;                         {by Judy Birmingham, 9/18/92}
  19.  Uses Crt;
  20.  
  21.  Const
  22.        {-------------------------------------------------------------------}
  23.        {These values will vary by the song you choose}
  24.        {I wish I could have made these variables instead of constants,
  25.        but I seemed to be locked into using const, because they define
  26.        array sizes in the types declared below.}
  27.  
  28.        TotalLinesInSong = 4;             {Number of lines in song}
  29.        MaxNotesInPhrase = 9;             {Max number of notes in any line}
  30.        BeatNote         = 4;             {Bottom number in Time Signature}
  31.                                          {Handles cut time (2/2), 6/8 etc.}
  32.        Tempo            = 160;           {Number of beats per minute}
  33.        {-------------------------------------------------------------------}
  34.        {Note frequencies}
  35.        R = 0;                            {Rest = frequency of 0 : silence}
  36.        C = 260;                          {Frequency of middle c          }
  37.        CC = 277;                         {Double letter indicates a sharp}
  38.        D = 294;
  39.        DD = 311;
  40.        E = 330;
  41.        F = 349;
  42.        FF = 370;
  43.        G = 392;
  44.        GG = 415;
  45.        A = 440;
  46.        AA = 466;
  47.        B = 494;
  48.  
  49.        {Note durations}
  50.        Q  = 1 * (BeatNote/4);                            {Quarter note}
  51.        I  = 0.5 * (BeatNote/4);                          {Eighth note}
  52.        H  = 2 * (BeatNote/4);                            {Half note}
  53.        W  = 4 * (BeatNote/4);                            {Whole note}
  54.        S  = 0.25 * (BeatNote/4);                         {Sixteenth note}
  55.        DQ = 1.5 * (BeatNote/4);                          {Dotted quarter}
  56.        DI = 0.75 * (BeatNote/4);                         {Dotted eighth}
  57.        DH = 3 * (BeatNote/4);                            {Dotted half}
  58.        DS = 0.375 * (BeatNote/4);                        {Dotted sixteenth}
  59.  
  60.        Beat = 60000/Tempo;       {Duration of 1 beat in millisecs}
  61.  
  62.  Type  IValues = Array [1..MaxNotesInPhrase] of Integer;
  63.        RValues = Array [1..MaxNotesInPhrase] of Real;
  64.        Phrase = Record
  65.                       Lyric :  String;
  66.                       Notes  : IValues;   {array of note frequencies}
  67.                       Octave : IValues;   {array of note octaves}
  68.                       Rhythm : RValues;   {array of note durations}
  69.                       end;
  70.        Song = Array [1..TotalLinesInSong] of Phrase;
  71.  
  72.  {Sample song}
  73.  CONST RowRow : Song =
  74.        (
  75.       (Lyric : 'Row Row Row Your Boat';
  76.       NOTES   :  (C,C,C,D,E,R,0,0,0);
  77.       OCTAVE  :  (1,1,1,1,1,1,0,0,0);
  78.       RHYTHM  :  (DQ,DQ,Q,I,Q,I,R,0,0)
  79.       ),
  80.  
  81.       (Lyric : 'Gently down the stream';
  82.       NOTES   :  (E,D,E,F,G,R,0,0,0);
  83.       OCTAVE  :  (1,1,1,1,1,1,0,0,0);
  84.       RHYTHM  :  (Q,I,Q,I,DQ,DQ,0,0,0)
  85.       ),
  86.  
  87.       (Lyric : 'Merrily merrily merrily merrily';
  88.       NOTES :  (C,C,G,G,E,E,C,C,0  );
  89.       OCTAVE : (2,2,1,1,1,1,1,1,0  );
  90.       RHYTHM : (Q,I,Q,I,Q,I,Q,I,0  )
  91.       ),
  92.  
  93.       (Lyric : 'Life is but a dream.';
  94.       NOTES  : (G,F,E,D,C,R,0,0,0  );
  95.       OCTAVE : (1,1,1,1,1,1,0,0,0  );
  96.       RHYTHM  : (Q,I,Q,I,H,Q,0,0,0  )
  97.       ));
  98.  
  99.  Procedure LYRICS (THE_WORDS : string);
  100.            begin
  101.            Writeln (THE_WORDS);
  102.            end;
  103.  
  104.  Procedure PLAYNOTE (NOTE, OCT: integer; DURATION : real);
  105.            begin
  106.            Sound (NOTE * OCT);
  107.            Delay (Round(BEAT * DURATION));
  108.            NoSound;
  109.            End;
  110.  
  111.  Procedure PLAYPHRASE (N : integer; NOTES, OCTAVE : IValues; RHYTHM :
  112. RValues) ;
  113.  
  114.            Var INDEX : Integer;
  115.            Begin
  116.            For INDEX := 1 to N do
  117.                PLAYNOTE (NOTES[INDEX], OCTAVE[INDEX], RHYTHM[INDEX]);
  118.            End;
  119.  
  120.  Procedure PLAYSONG (Title : String; Tune : Song);
  121.  
  122.            Var Counter : Integer;
  123.  
  124.            begin
  125.            ClrScr;
  126.            GotoXY(11,3);
  127.            Writeln (Title);
  128.            Window (10,5,70,19);
  129.            ClrScr;
  130.            For counter := 1 to TotalLinesInSong do
  131.                begin
  132.                LYRICS(Tune[counter].Lyric);
  133.                PLAYPHRASE(MaxNotesInPhrase,Tune[counter].Notes,
  134.                           Tune[counter].Octave, Tune[counter].Rhythm);
  135.                end;
  136.           end;
  137.  
  138.  BEGIN
  139.        ClrScr;
  140.        PlaySong ('"Row Row Row Your Boat "', RowRow);
  141.  END.
  142.  
  143. ... Dyslexic atheists don't believe in Dog.
  144. --- Blue Wave/QBBS v2.12 [NR]
  145.  * Origin: Screen Magic -Rockwood, MI- (1:2410/225.0)
  146.  
  147.